home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / cvs-1_3.lha / cvs-1.3 / contrib / rcslock.pl < prev    next >
Perl Script  |  1992-03-30  |  7KB  |  235 lines
  1. #!/usr/bin/perl
  2.  
  3. # Author: John Rouillard (rouilj@cs.umb.edu)
  4. # Supported: Yeah right. (Well what do you expect for 2 hours work?)
  5. # Blame-to: rouilj@cs.umb.edu
  6. # Complaints to: Anybody except Brian Berliner, he's blameless for
  7. #         this script.
  8. # Acknowlegements: The base code for this script has been acquired
  9. #            from the log.pl script.
  10.  
  11. # rcslock.pl - A program to prevent commits when a file to be ckecked
  12. #            in is locked in the repository.
  13.  
  14. # There are times when you need exclusive access to a file.  This
  15. # often occurs when binaries are checked into the repository, since
  16. # cvs's (actually rcs's) text based merging mechanism won't work. This
  17. # script allows you to use the rcs lock mechanism (rcs -l) to make
  18. # sure that no changes to a repository are able to be committed if
  19. # those changes would result in a locked file being changed.
  20.  
  21. # WARNING:
  22. # This script will work only if locking is set to strict.
  23. #
  24.  
  25. # Setup:
  26. # Add the following line to the commitinfo file:
  27.  
  28. #         ALL /local/location/for/script/lockcheck [options]
  29.  
  30. # Where ALL is replaced by any suitable regular expression.
  31. # Options are -v for verbose info, or -d for debugging info.
  32. # The %s will provide the repository directory name and the names of
  33. # all changed files.  
  34.  
  35. # Use:
  36. # When a developer needs exclusive access to a version of a file, s/he
  37. # should use "rcs -l" in the repository tree to lock the version they
  38. # are working on.  CVS will automagically release the lock when the
  39. # commit is performed.
  40.  
  41. # Method:
  42. # An "rlog -h" is exec'ed to give info on all about to be
  43. # committed files.  This (header) information is parsed to determine
  44. # if any locks are outstanding and what versions of the file are
  45. # locked.  This filename, version number info is used to index an
  46. # associative array.  All of the files to be committed are checked to
  47. # see if any locks are outstanding.  If locks are outstanding, the
  48. # version number of the current file (taken from the CVS/Entries
  49. # subdirectory) is used in the key to determine if that version is
  50. # locked. If the file being checked in is locked by the person doing
  51. # the checkin, the commit is allowed, but if the lock is held on that
  52. # version of a file by another person, the commit is not allowed.
  53.  
  54. $ext = ",v";  # The extension on your rcs files.
  55.  
  56. $\="\n";  # I hate having to put \n's at the end of my print statements
  57. $,=' ';   # Spaces should occur between arguments to print when printed
  58.  
  59. # turn off setgid
  60. #
  61. $) = $(;
  62.  
  63. #
  64. # parse command line arguments
  65. #
  66. require 'getopts.pl';
  67.  
  68. &Getopts("vd"); # verbose or debugging
  69.  
  70. # Verbose is useful when debugging
  71. $opt_v = $opt_d if defined $opt_d;
  72.  
  73. # $files[0] is really the name of the subdirectory.
  74. # @files = split(/ /,$ARGV[0]);
  75. @files = @ARGV[0..$#ARGV];
  76. $cvsroot = $ENV{'CVSROOT'};
  77.  
  78. #
  79. # get login name
  80. #
  81. $login = getlogin || (getpwuid($<))[0] || "nobody";
  82.  
  83. #
  84. # save the current directory since we have to return here to parse the
  85. # CVS/Entries file if a lock is found.
  86. #
  87. $pwd = `/bin/pwd`;
  88. chop $pwd;
  89.  
  90. print "Starting directory is $pwd" if defined $opt_d ;
  91.  
  92. #
  93. # cd to the repository directory and check on the files.
  94. #
  95. print "Checking directory ", $files[0] if defined $opt_v ;
  96.  
  97. if ( $files[0] =~ /^\// )
  98. {
  99.    print "Directory path is $files[0]" if defined $opt_d ;
  100.    chdir $files[0] || die "Can't change to repository directory $files[0]" ;
  101. }
  102. else
  103. {
  104.    print "Directory path is $cvsroot/$files[0]" if defined $opt_d ;
  105.    chdir ($cvsroot . "/" . $files[0]) || 
  106.          die "Can't change to repository directory $files[0] in $cvsroot" ;
  107. }
  108.  
  109.  
  110. # Open the rlog process and apss all of the file names to that one
  111. # process to cut down on exec overhead.  This may backfire if there
  112. # are too many files for the system buffer to handle, but if there are
  113. # that many files, chances are that the cvs repository is not set up
  114. # cleanly.
  115.  
  116. print "opening rlog -h @files[1..$#files] |" if defined $opt_d;
  117.  
  118. open( RLOG, "rlog -h @files[1..$#files] |") || die "Can't run rlog command" ;
  119.  
  120. # Create the locks associative array.  The elements in the array are
  121. # of two types:
  122. #
  123. #  The name of the RCS file with a value of the total number of locks found
  124. #            for that file,
  125. # or
  126. #
  127. # The name of the rcs file concatenated with the version number of the lock.
  128. # The value of this element is the name of the locker.
  129.  
  130. # The regular expressions used to split the rcs info may have to be changed.
  131. # The current ones work for rcs 5.6.
  132.  
  133. $lock = 0;
  134.  
  135. while (<RLOG>)
  136. {
  137.     chop;
  138.     next if /^$/; # ditch blank lines
  139.  
  140.     if ( $_ =~ /^RCS file: (.*)$/ )
  141.     {
  142.        $curfile = $1;
  143.        next;
  144.     }
  145.  
  146.     if ( $_ =~ /^locks: strict$/ )
  147.     {
  148.         $lock = 1 ;
  149.       next;
  150.     }
  151.  
  152.     if ( $lock )
  153.     {
  154.       # access list: is the line immediately following the list of locks.
  155.       if ( /^access list:/ )
  156.       { # we are done getting lock info for this file.
  157.         $lock = 0;
  158.       }
  159.       else
  160.       { # We are accumulating lock info.
  161.  
  162.         # increment the lock count
  163.         $locks{$curfile}++;
  164.         # save the info on the version that is locked. $2 is the
  165.             # version number $1 is the name of the locker.
  166.         $locks{"$curfile" . "$2"} = $1 
  167.                 if /[     ]*([a-zA-Z._]*): ([0-9.]*)$/;
  168.  
  169.         print "lock by $1 found on $curfile version $2" if defined $opt_d;
  170.  
  171.       }
  172.     }
  173. }
  174.  
  175. # Lets go back to the starting directory and see if any locked files
  176. # are ones we are interested in.
  177.  
  178. chdir $pwd;
  179.  
  180. # fo all of the file names (remember $files[0] is the directory name
  181. foreach $i (@files[1..$#files])
  182. {
  183.   if ( defined $locks{$i . $ext} )
  184.   { # well the file has at least one lock outstanding
  185.  
  186.      # find the base version number of our file
  187.      &parse_cvs_entry($i,*entry);
  188.  
  189.      # is our version of this file locked?
  190.      if ( defined $locks{$i . $ext . $entry{"version"}} )
  191.      { # if so, it is by us?
  192.     if ( $login ne ($by = $locks{$i . $ext . $entry{"version"}}) )
  193.     {# crud somebody else has it locked.
  194.        $outstanding_lock++ ;
  195.        print "$by has file $i locked for version " , $entry{"version"};
  196.     }
  197.     else
  198.     { # yeah I have it locked.
  199.        print "You have a lock on file $i for version " , $entry{"version"}
  200.         if defined $opt_v;
  201.     }
  202.      }
  203.   }
  204. }
  205.  
  206. exit $outstanding_lock;
  207.  
  208.  
  209. ### End of main program
  210.  
  211. sub parse_cvs_entry
  212. { # a very simple minded hack at parsing an entries file.
  213. local ( $file, *entry ) = @_;
  214. local ( @pp );
  215.  
  216.  
  217. open(ENTRIES, "< CVS/Entries") || die "Can't open entries file";
  218.  
  219. while (<ENTRIES>)
  220.  {
  221.   if ( $_  =~ /^\/$file\// )
  222.   {
  223.     @pp = split('/');
  224.  
  225.     $entry{"name"} = $pp[1];
  226.     $entry{"version"} = $pp[2];
  227.     $entry{"dates"} = $pp[3];
  228.     $entry{"name"} = $pp[4];
  229.     $entry{"name"} = $pp[5];
  230.     $entry{"sticky"} = $pp[6];
  231.     return;
  232.   }
  233.  }
  234. }
  235.